home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fcirctxt.F < prev    next >
Text File  |  1991-06-03  |  3KB  |  173 lines
  1. c
  2. c display all the hershey fonts and demonstrate textang
  3. c
  4.     program fcirctxt
  5.  
  6. #ifdef SGI
  7. #include "fgl.h"
  8. #include "fdevice.h"
  9. #else
  10. #include "fvogl.h"
  11. #include "fvodevice.h"
  12. #endif
  13.     character*40 str1, str2, str3, str4, fonts(22)
  14.     character*100 buf
  15.     integer i
  16.     integer *2 val
  17.     data fonts/ 'astrology', 'cursive', 'futura.l',
  18.      +      'futura.m', 'gothic.eng', 'gothic.ger',
  19.      +      'gothic.ita', 'greek', 'japanese', 'markers',
  20.      +      'math.low', 'math.upp', 'meteorology', 'music',
  21.      +      'cyrillic', 'script', 'symbolic', 'times.g',
  22.      +      'times.ib', 'times.i', 'times.r', 'times.rb' /
  23.  
  24.     data str1/ 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
  25.     data str2/ 'abcdefghijklmnopqrstuvwxyz' /
  26.     data str3/ '1234567890+-=!@#$%^&*(){}[]' /
  27.     data str4/ '<>,./?~`\|_BONK,blark' /
  28.  
  29.     call winope("fcirctxt", 8)
  30.  
  31. c
  32. c we are interested in Keyboard events...
  33. c
  34.     call unqdev(INPUTC)
  35.     call qdevic(KEYBD)
  36.  
  37.     call color(BLACK)
  38.     call clear
  39.  
  40. c
  41. c define the world space
  42. c
  43.     call ortho2(-14.0, 14.0, -14.0, 14.0)
  44.  
  45.     do 10 i = 1, 22
  46.  
  47. c
  48. c textang is used to specify the orientation of text. As
  49. c we want the title to come out straight we make sure it is
  50. c zero each time we go through this loop.
  51. c
  52.         call htexta(0.0)
  53.  
  54. c
  55. c do the title
  56. c
  57.         call color(YELLOW)
  58.         call hfont('futura.m', 8)
  59.         buf = ' '
  60.         write(buf, '(''This is Hershey font '',a)') fonts(i)
  61.         call hboxte(-11.0, 12.0, 20.0, 1.0, buf, 32)
  62.  
  63. c
  64. c draw a box around the title
  65. c
  66.         call rect(-11.0, 12.0, 9.0, 13.0)
  67.  
  68.         call color(GREEN)
  69.  
  70. c
  71. c grab a font from the table
  72. c
  73.         call hfont(fonts(i), nchars(fonts(i)))
  74.  
  75. c
  76. c show the outer ring
  77. c
  78.         call htexts(1.5, 1.5)
  79.         call ShowCi(11.0, str1)
  80.  
  81. c
  82. c show the second ring
  83. c
  84.         call htexts(1.3, 1.3)
  85.         call ShowCi(8.5, str2)
  86.  
  87. c
  88. c show the third ring
  89. c
  90.         call htexts(1.1, 1.1)
  91.         call ShowCi(7.0, str3)
  92.  
  93. c
  94. c show the inside ring
  95. c
  96.         call htexts(0.9, 0.9)
  97.         call ShowCi(5.0, str4)
  98.  
  99.         idum = qread(val)
  100.         if (idum .eq. QKEY) then
  101.         call gexit
  102.         stop
  103.         end if
  104.  
  105.         call color(BLACK)
  106.         call clear
  107. 10    continue
  108.  
  109.     call gexit
  110.  
  111.     end
  112. c
  113. c nchars
  114. c
  115. c return the real length of a string padded with blanks
  116. c
  117.     integer function nchars(str)
  118.     character *(*) str
  119.  
  120.     do 10 i = len(str), 1, -1
  121.         if (str(i:i) .ne. ' ') then
  122.             nchars = i
  123.             return
  124.         end if
  125. 10      continue
  126.  
  127.     nchars = 0
  128.  
  129.     return
  130.  
  131.     end
  132. c
  133. c ShowCi
  134. c
  135. c    show a ring of text
  136. c
  137.     subroutine ShowCi(r, str)
  138.     real r
  139.     character*(*) str
  140.  
  141.     real i, inc, x, y, a, pi
  142.     integer j
  143.     character*1 c
  144.     parameter (pi = 3.1415926535)
  145.  
  146.     j = 1
  147.     inc = 360.0 / nchars(str)
  148.  
  149.     do 10 i = 0, 360.0, inc
  150. c
  151. c calculate the next drawing position
  152. c
  153.         c = str(j:j)
  154.         x = r * cos(i * pi / 180.0)
  155.         y = r * sin(i * pi / 180.0)
  156.         call move2(x, y)
  157. c
  158. c calculate angle for next character
  159. c
  160.         a = 90.0 + i
  161. c
  162. c set the orientation of the next character
  163. c
  164.         call htexta(a)
  165. c
  166. c draw the character
  167. c
  168.         call hdrawc(c)
  169.         j = j + 1
  170. 10    continue
  171.  
  172.     end
  173.